Data Authenticator for the Deployable Seismic Verification System

[145]

### APPENDIX S

### Test Source Code

[146]

    This listing contains ROMable metacompilable authenticator source
    test code.  The code is inserted just after the definition of
    ONGOSUB, page 319 and just before VOCABULARY ASSEMBLER IMMEDIATE
    seen in screen 143 in the book describing the hardware/software
    development system written by the author.  The interrupt vectors
    need to be patched to point to the assembler code in the
    application.  This code was used in for downhole and laboratory
    testing the authenticator.

    151
    \                                                 16:36 01/26/90
    DECIMAL
    256      CONSTANT WBUFSIZ
    0        VARIABLE WBUF -2 ALLOT-RAM WBUFSIZ ALLOT-RAM
    : ERASEWBUF     WBUF WBUFSIZ ERASE ;

    \ --- address\length
    : @WBAD WBUF DUP C@ ;
    \ --- status byte
    : .WBUF BASE @ >R HEX WBUF DUP C@ DUP 0>
    IF OVER + SWAP DO I C@ 0 <# # # #> TYPE LOOP
    ELSE DROP DROP
    THEN R> BASE ! ;
    : >DHL  @WBAD 2- 2DUP + >R CRC R> ! ( CR ." Response " .WBUF )
    @WBAD WMESS ;

    152
    \                                                 20:54 11/30/89
    DECIMAL
    0        VARIABLE WBUFPTR
    3        VARIABLE MQPTR

    : OWBUFPTR      0 WBUFPTR ! ;
    : 3MQPTR        3 MQPTR ! ;

    \ byte ---
    : >WBUF         WBUFPTR @ WBUF + C! 1 WBUFPTR +! ;
    \ --- byte
    : MQ>           MQPTR @ MQ + C@ 1 MQPTR +! ;
    \ byte --- status byte
    : SENDSTATUS    0WBUFPTR 5 >WBUF 0 >WBUF >WBUF >DHL ;
    -->

    153
    \                                                 21:37 12/21/89

    [147]

    HEX
    FF60    CONSTANT WATCHDOG
    FF70    CONSTANT BUZZER
    FF80    CONSTANT CLKCLDR
    7F      CONSTANT ASP \ user assembler stack pointer
    E0      CONSTANT ACC.0 El CONSTANT ACC.1
    : .DOG          BASE @ >R 2 BASE !
                    WATCHDOG C@ 0 <# # # # # # # # # #>
                    TYPE R> BASE ! ;
    : CLRDOG        0 WATCHDOG C! ;
    : DOG           [ WATCHDOG 1+ ] LITERAL C@ DROP ;
    : -DOG          0 [ WATCHDOG 1+ ] LITERAL C! ;
    : -DOSC         [ WATCHDOG   2+ ] LITERAL C@ DROP ;
    : DOSC          0 [ WATCHDOG 2+ ] LITERAL C! ;
    -->
    154
    \                                                 21:25 01/31/89
    HEX
    : FIDO  CLS -CURSOR 2 BASE ! ." Watchdog Timer Demo"
            CR ." Hit a key to reset the dog"
            CR ."   or Esc to stop the dog" CLRDOG DOSC DOG
            BEGIN  0 3 GOTOXY .DOG ?TERMINAL
              IF KEY 1B =
                IF -DOG -DOSC CURSOR DECIMAL QUIT
                ELSE CLRDOG
                THEN
              THEN
            AGAIN ; -->

    155
    \                                                 19:31 06/29/89
    HEX
    : 100SEC        CLKCLDR ;
    : HOURS         t CLKCLDR 1+  ] LITERAL ;
    : MINUTES       [ CLKCLDR 2+  ] LITERAL ;
    : SECONDS       [ CLKCLDR 3 + ] LITERAL ;
    : MONTH         [ CLKCLDR 4 + ] LITERAL ;
    : DAY           [ CLKCLDR 5 + ] LITERAL ;
    : YEAR          [ CLKCLDR 6 + ] LITERAL ;
    : MTW           [ CLKCLDR 7 + ] LITERAL ; -->

    156
    \                                                 19:44 06/29/89
    HEX
    : RAM100        [ CLKCLDR 8 +  ] LITERAL ;
    : RAMHOURS      [ CLKCLDR 9 +  ] LITERAL ;
    : RAMMIN        [ CLKCLDR 0A + ] LITERAL ;
    : RAMSEC        [ CLKCLDR 0B + ] LITERAL ;
    : RAMMONTH      [ CLKCLDR 0C + ] LITERAL ;
    : RAMDATE       [ CLKCLDR 0D + ] LITERAL ;
    : RAMYEAR       [ CLKCLDR 0E + ] LITERAL ;
    : RAMMTW        [ CLKCLDR 0F + ] LITERAL ; .
    : INTMASK       [ CLKCLDR 10 + ] LITERAL ;
    : COMMAND       [ CLKCLDR 11 + ] LITERAL ; -->

    [148]

    157
    \                                                 03:06 11/29/89
    DECIMAL
    : @100SEC  100SEC C@ DROP ;
    \ byte
    : @SEC  @100SEC SECONDS C@ ;
    \ byte
    : @MIN  @100SEC MINUTES C@ ;
    \ byte
    : @HRS  @100SEC HOURS C@ ;
    -->

    158
    \                                                 03:06 11/29/89
    DECIMAL
    \ byte
    : @YEAR @100SEC YEAR C@ ;
    \ byte
    : @DAY  @100SEC DAY C@ ;
    \ byte
    : @MON  @100SEC MONTH C@ ;
    \ byte
    : @MTW  @100SEC MTW C@ ;
    \ --- seconds\minutes\hours
    : @TIME @SEC @MIN @HRS ;

    \ --- year\day\month\day of week
    : @DATE @YEAR @DAY @MON @MTW ;
    -->
    159
    \                                                   20:19 11/29/89
    HEX
    : MON ." Monday" ;                : TUE   ." Tuesday" ;
    : WED ." Wednesday" ;             : THURS ." Thursday" ;
    : FRI ." Friday" ;                : SAT   ." Saturday" ;
    : SUN ." Sunday" ;

    : DAYOFWEEK  ONGOSUB MON TUE WED THURS FRI SAT SUN ENDGOSUB ;
    -->

    160
    \                                                 20:19 11/29/89
    HEX
    \ seconds\minutes\hours ---
    : (.TIME) DUP 80 AND >R OF AND 0 <# # # #> TYPE ." :"
            0 <# # # #> TYPE ." :"
            0 <# # # #> TYPE
            R> IF ."  pm" ELSE ."  am" THEN ;

    : .TIME @TIME (.TIME) ;
    \ year\day\month\day of week ---
    : (.DATE) DAYOFWEEK SPACE
            0 <# # # #> TYPE ." /"
            0 <# # # #> TYPE ." /"
            0 <# # # #> TYPE ;

    [149]

    : .DATE @DATE (.DATE) ;  -->
    161
    \                                                 20:18 11/29/89
    DECIMAL
    \ hours\minutes\seconds ---
    : !TIME         0 COMMAND C!
                    SECONDS C! MINUTES C! HOURS C!
                    8 COMMAND C!

    \ day of week\month\day\year ---
    : !DATE         0 COMMAND C!
                    YEAR C! DAY C! MONTH C! MTW C!
                    8 COMMAND C!

    : SHOWTIME      CLS -CURSOR .DATE CR
                    BEGIN 0 1 GOTOXY .TIME
                    ?TERMINAL UNTIL CURSOR ;

    -->
    162
    \                                                 20:54 11/30/89
    DECIMAL
    : SETTIME       3MQPTR MQ> MQ> MQ> !TIME
                    MQ> MQ> MQ> MQ> !DATE ;

    \ --- status byte
    : SENDTIME      OWBUFPTR 11 >WBUF 2 >WBUF
                    @TIME >WBUF >WBUF >WBUF
                    @DATE >WBUF >WBUF >WBUF >WBUF >DHL ; -->

    163
    \                                                 14:09 06/29/89
    HEX
    \ value ---
    CODE !LED (S0) LCALL
              R4 DPH MOV R5 DPL MOV
              DPTR # BUZZER MOV
              A S0L MOV
              @DPTR A MOVX            \ store value
              NEXT LJMP
              END-CODE

    -->

    164
    \                                                 14:21 06/29/89
    HEX
    HERE LABEL (PAUSE) ASSEMBLER RESET BEGIN$
            @DPTR A MOVX                    \ 2 microseconds
            R0 S1L MOV                      \ 2
            R1 S1H MOV                      \ 2
      1 $: R0 1 $ DJNZ                      \ 2
            R1 1 $ DJNZ                     \ 2
            RET \ microseconds              \ 2.
    END$ FORTH -->
    \ time in microseconds = 6 + 2*256* highcount + 2*low count

    [150]

    if lowcount <> zero, then highcount = highcount + 1
    Roughly, time in microsconds = 2 *count

    165
    \                                                14: 21 06/29/89

    \ adj duration low\ adj duration high\duty cycle low\
    \ duty cycle high\0=no buzz.l=buzz ---
    HERE LABEL (BUZZ) ASSEMBLER RESET BEGIN$
                    R0 ASP MOV
                    S2L @R0 MOV  R0 INC     \ buzz or no buzz
                    S1H @R0 MOV  R0 INC     \ high duty
                    S1L @R0 MOV  R0 INC     \ low duty
                    S0H @R0 MOV  R0 INC     \ high duration
                    S0L @R0 MOV  ASP R0 MOV \ low duration
                    DPTR # BUZZER MOV
                    A S0L MOV  0<> IF S0H INC THEN
                    A S1L MOV  0<> IF S1H INC THEN -->

    166
    \                                                13: 28 06/29/89
              1 $:  A S2L MOV 0<>                  \ phase 1
                    IF  A @DPTR MOVX
                    ACC.0 SETB ACC. 1 CLR          \ buzz
                    ELSE ACC.0 CLR ACC. 1 CLR      \ no buzz
                    THEN (PAUSE) LCALL
                    A S2L MOV 0<>                  \ phase 2
                    IF  A @DPTR MOVX
                    ACC.0 CLR ACC. 1 SETB          \ buzz
                    ELSE ACC. 0 CLR ACC. 1 CLR     \ no buzz
                    THEN (PAUSE) LCALL
                    ACC. 0 CLR ACC. 1 CLR @DPTR A MOVX \ no current
                    S0L 1 $ DJNZ S0H 1 $ DJNZ
                    RET
    END$ FORTH -->
    167
    \                                                15: 25 08/26/89

    \ duration\frequency\0=no buzz,1=buzz ---
    CODE BUZZ ASP # ASP MOV
              (S0) LCALL (S1) LCALL (S2) LCALL
              R0 AS P MOV R0 DEC
              @R0 S2L MOV R0 DEC
              @R0 S2H MOV R0 DEC
              @R0 S1L MOV R0 DEC
              @R0 S1H MOV R0 DEC
              @R0 S0L MOV ASP R0 MOV
              R4 DPH MOV R5 DPL MOV
              (BUZZ) LCALL NEXT LJMP END-CODE -->

    168
    \                                                15: 25 08/26/89
    HEX
    \ frequency\duration --- adj duration\duty cycle count

    [151]

    : DUTY  SWAP >R D090 3 R> U/ SWAP DROP SWAP OVER
            >R 9638 1C R> U/ SWAP DROP M* lF40 U/ SWAP DROP SWAP ;

    DECIMAL
    \ frequency\duration ---
    : BEEP  OVER 0=
              IF SWAP DROP 440 SWAP DUTY 0
              ELSE DUTY 1
              THEN BUZZ ; -->

    169
    \                                                 14:49 02/22/89
    HEX
    FF50         CONSTANT EEPROM
    EEPROM 1+  CONSTANT EELOW
    EEPROM 2+  CONSTANT EEHIGH
    EEPROM 3 + CONSTANT EESETUP
    EEPROM 4 + CONSTANT EE12 -->

    170
    \                                                 03:08 12/16/89
    HEX
    \ byte --- byte
    CODE >< (S0) LCALL  A S0H MOV  @DPTR A MOVX
            A S0L MOV  APUSH LJMP  END-CODE

    \ address --
    : EEAD  DUP EELOW C! >< EEHIGH C! ;
    \ address --- byte

    171
    \                                                 07:24 12/16/89
    HEX
    \ address --- byte
    CODE EC@        (S0) LCALL R4 DPH MOV R5 DPL MOV
                    A S0L MOV DPTR # EELOW MOV
                    @DPTR A MOVX DPTR INC
                    A S0H MOV @DPTR A MOVX
                    DPTR # EEPROM MOV A @DPTR MOVX
                    DPH R4 MOV DPL R5 MOV
                    A0PUSH LJMP END-CODE

    -->
    : EC@   EEAD EEPROM C@ ;

    172
    \                                                 07:25 12/16/89
    DECIMAL
    0       VARIABLE EC!TO \ ec! timeout
    20      CONSTANT EC!RETRIES
    \ byte\address ---
    : EC!   0 EC!TO ! 2DUP EEAD EEPROM C! EC!RETRIES 0
            DO 2DUP EC@ XOR 0=
              IF 0 EC!TO ! LEAVE
              THEN

    [152]

            LOOP DROP DROP ; -->

    \ byte\address ---
    : EC!   2DUP EEAD EEPROM C!
            BEGIN 2DUP EC@ XOR DUP
              IF CR ." EEPROM busy" THEN 0=
            UNTIL DROP DROP ;
    173
    \                                                 04:13 11/20/89
    HEX
    \ --- byte
    : ES@   EESETUP C@ ;
    : 12EN  0 EE12 C! ;

    : NORMAL        0 EESETUP C! ;
    : INITEE        NORMAL 0 EE12 C! ; -->

    174
    \                                                 11:35 02/23/89
    HEX
    : -CE   EESETUP C@  10 OR  EESETUP C! ;
    : CE    EESETUP C@ 0EF AND EESETUP C! ;
    : -WE   EESETUP C@   8 OR  DF AND EESETUP C! ;
    : WE    EESETUP C@ 0D7 AND EESETUP C! ;
    : WE5   EESETUP C@  20 OR  EESETUP C! ;
    : A912  EESETUP C@   4 OR  EESETUP C! ;
    : A9    EESETUP C@ 0FB AND EESETUP C! ;
    : 0E5   EESETUP C@ 0FC AND 1 OR EESETUP C! ;
    : 0E12  EESETUP C@ 0FC AND 2 OR EESETUP C! ;
    : 0E    EESETUP C@ 0FC AND     EESETUP C! ; -->

    175
    \                                                 11:26 02/23/89
    HEX
    : NORM     ." pulsing low" ;
    : HIGH     ." +5" ;
    : TWELVE   ." +12" ;
    : INVALOE  ." Invalid" ;
    : .EES  EESETUP C@
            DUP 80 AND
            CR IF ." Armed!" ELSE ." Reset" THEN ."  EEPROM status"
            DUP 40 AND
            CR IF ." 1" ELSE ." 0" THEN ."  not used"
            DUP 20 AND
            CR IF ." +5" ELSE ." 0" THEN ."  WE+5"
            DUP 10 AND
            CR IF ." 0" ELSE ." 1" THEN ."  -CE" -->

    176
    \                                                010:54 02/23/89

            DUP  8 AND
            CR IF ." 0" ELSE ." pulsing low" THEN ."  -WE"
            DUP  4 AND
            CR IF ." +12 " ELSE ." pulsing" THEN ."  A9"

    [153]

            3 AND CR
            ONGOSUB NORM HIGH TWELVE INVALOE ENDGOSUB
            ."  -OE" : -->

    177
    \                                                  11:38 02/23/89
    HEX
    : WAIT 1000 0 DO LOOP ; \ wait 10 msec

    : ECHIP WE5 0E5 0E12 -CE -WE WAIT WE5 CE 0E5 0E WE ;
    \ address ---
    : ?EERANGE      DUP 7FC0 <
                    IF CR ." address too small" QUIT THEN
                    7FFF >
                    IF CR ." address too big" QUIT THEN ;

    \ byte\address ---
    : EEC! A912 DUP ?EERANGE EC! A9 :

    \ address --- byte
    : EEC@ A912 DUP ?EERANGE EC@ A9 ; -->
    178
    \ Standalone 8085 FORTH DUMP word                 15:27 01/13/89
    DECIMAL
    : EDUMP ( addr n ---  )
      BASE @ >R HEX CR CR 5 SPACES
      16 0 DO I 3 .R LOOP 2 SPACES
      16 0 DO I 0 <# # #> TYPE LOOP CR
      OVER + SWAP DUP 15 AND XOR DO
      CR I 0 4 D.R SPACE
      I 16 + I 2DUP
        DO I EC@ SPACE 0 <# # # #> TYPE LOOP
        2 SPACES
        DO I EC@ DUP 32 < OVER 126 > OR IF DROP 46 THEN
        EMIT LOOP
      16 +LOOP CR R> BASE ! ; -->

    179
    \ Standalone 8085 FORTH DUMP word                 14:17 07/10/89
    HEX
    : EEDUMP A912 7FC0 40
      BASE @ >R HEX CR CR 5 SPACES
      10 0 DO I 3 .R LOOP 2 SPACES
      10 0 DO I 0 <# # #> TYPE LOOP CR
      OVER + SWAP DUP OF AND XOR DO
      CR I 0 4 D.R SPACE
      I 10 + I 2DUP
        DO I EEC@ SPACE 0 <# # # #> TYPE LOOP
        2 SPACES
        DO I EEC@ DUP 20 < OVER 7E > OR IF DROP 2E THEN
        EMIT LOOP
      10 +LOOP CR R> BASE ! A9 :
    -->

    [154]

    \                                                 22:56 12/23/89
    HEX
    8000            CONSTANT EESIZE
    DECIMAL
    EESIZE 2-       CONSTANT MAXKEY#
    EESIZE 4 -      CONSTANT MAXUKEY#
    EESIZE 6 -      CONSTANT CURRENTKEY#
    EESIZE 10 -     CONSTANT CURRENTFC
    -->

    181
    \                                                 02:41 12/24/89
    DECIMAL
    52 5 * DUP 10 / +
            CONSTANT #KEYS
    7       CONSTANT #UKEYS

    \ --- status byte
    : EEKEY#        0WBUFPTR 6 >WBUF 11 >WBUF
                    CURRENTKEY# DUP EC@ >WBUF 1+ EC@ >WBUF >DHL ;
    : EESETKEY#     3MQPTR MQ> CURRENTKEY# EC!
                    MQ> CURRENTKEY# 1+ EC!
    HEX
    : .EEKEY#       CR CURRENTKEY# DUP EC@ >< SWAP 1+ EC@ OR U. ;
    -->

    182
    \                                                 02:04 11/30/89
    DECIMAL
    38      CONSTANT EEKEYLENGTH
    \ address ---
    : .EEKS CR ." Key status  " EC@ .8BITS ;
    \ address ---
    : .EEV  CR ." V " DUP EC@ .8BITS 1+ EC@ SPACE .8BITS ;
    \ address ---
    : .EEF  CR ." F "
            DUP     EC@       .8BITS DUP 1+  EC@ SPACE .8BITS
            DUP 2+  EC@ SPACE .8BITS DUP 3 + EC@ SPACE .8BITS
            DUP 4 + EC@ SPACE .8BITS DUP 5 + EC@ SPACE .8BITS
            DUP 6 + EC@ SPACE .8BITS     7 + EC@ SPACE .8BITS ;
    \ address ---
    : .EECRC  CR ." crc  "  DUP EC@ .8BITS 1+ EC@ SPACE .8BITS ;
    -->
    183
    \                                                 03:17 12/24/89
    DECIMAL
    \ address ---
    : .EEDATE       >R R EC@ R 1+ EC@ R 2+ EC@ R> 3 + EC@ (.DATE) ;
    \ address ---
    : .EETIME       >R R EC@ R 1+ EC@ R> 2+ EC@ (.TIME) ;
    \ address ---
    : .EEFC         CR ." Frame counter " >R
                    R 2+ EC@ >< R 3 + EC@ OR
                    R EC@ >< R> 1+ EC@ OR D. ;
    \ key number --- adjusted key number

    [155]

    : KEY#ADJ       DUP 0< IF ABS #KEYS + THEN ;
    -->

    184
    \                                                 03:19 12/24/89
    DECIMAL
    \ number ---
    : .EEKEY        CR ." Key number " DUP . KEY#ADJ
                    EEKEYLENGTH * DUP .EEKS
                    DUP 1+ .EEV DUP 3 + .EEF DUP 11 + .EECRC
                    CR ." Key initialized  "
                    DUP 17 + .EETIME SPACE DUP 13 + .EEDATE
                    CR ." Key activated  "
                    DUP 24 + .EETIME SPACE DUP 20 + .EEDATE
                    CR ." Key deactivated  "
                    DUP 31 + .EETIME SPACE DUP 27 + .EEDATE
                    34 + .EEFC ;
    -->

    185
    \                                                 03:18 12/24/89
    HEX
    : >EEKEY  3MQPTR MQ> >< MQ> OR KEY#ADJ EEKEYLENGTH *
              0FE OVER EC!
              0C 0 DO 1+ MQ> OVER EC! LOOP
              1+ @YEAR OVER EC!
              1+ @DAY OVER EC!
              1+ @MON OVER EC!
              1+ @MTW OVER EC!
              1+ @SEC OVER EC!
              1+ @MIN OVER EC!
              1+ @HRS OVER EC!
              12 0 DO 1+ 0 OVER EC! LOOP DROP ;

    186
    \                                                 21:06 12/25/89
    DECIMAL
    \ key # ---
    : (EEKEY>)      OWBUFPTR 42 >WBUF 18 >WBUF
                    DUP DUP >< >WBUF >WBUF KEY#A W
                    EEKEYLENGTH *
                    38 0 DO I OVER + EC@ >WBUF LOOP DROP ;
    \ key # --- status byte
    : EEKEY>        (EEKEY>) WBUF 4 + C@ 4 AND
                    IF 5 WBUFPTR ! 10 0 DO 0 >WBUF LOOP THEN
                    >DHL ;
    HEX
    \ --- 0 yes, 1 no
    : EEFFS         0 8000 0 DO I EC@ OFF - OR LOOP
                    IF 1 ELSE 0 THEN ;

    187
    \                                                 19:05 07/03/89
    HEX

    [156]

    FF00    CONSTANT XBUS     \ external bus
    FFB0    CONSTANT BUSVIEW  \ busview on bus decode card

    90      CONSTANT P1.0     91      CONSTANT P1.1
    96      CONSTANT P1.6
    0B0     CONSTANT P3       OB0     CONSTANT P3.0
    0B1     CONSTANT P3.1     98      CONSTANT SCON.O
    E2      CONSTANT ACC.2
    E6      CONSTANT ACC.6
    D0      CONSTANT PARITY
    FFA0    CONSTANT CS       \ command/status
    -->
    : DEXT  0 [ CS 3 + ] LITERAL C! ;
    : DINT  0 [ CS 4 + ] LITERAL C! ;  -->
    188
    \                                                 08:52 07/02/89
    DECIMAL
    \ select the hardware d register software clock
    HERE LABEL (DEXT) ASSEMBLER RESET BEGIN$
            DPTR # CS 3 + MOV
            @DPTR A MOVX
            RET
    ENDS FORTH
    HERE LABEL (DINT) ASSEMBLER RESET BEGIN$
            DPTR # CS 4 + MOV
            @DPTR A MOVX
            RET  END$ FORTH
    CODE DINT (DINT) LCALL  NEXT LJMP  END-CODE
    CODE DEXT (DEXT) LCALL  NEXT LJMP  END-CODE -->

    189
    \                                                 13:42 06/30/89
    HEX
    \ --- byte
    : @ID                    CS C@ ; \ @ internal data

    CODE SB P1.0 3 + SETB  NEXT LJMP  END-CODE
    CODE -SB P1.O 3 + CLR  NEXT LJMP  END-CODE
    CODE SPOLL P1.O 1+ SETB  NEXT LJMP  END-CODE
    CODE -SPOLL P1.O 1+ CLR  NEXT LJMP  END-CODE -->

    190
    \                                                 13:00 06/30/89
    HEX
    \ byte ---
    : ZO1   CR IF ." 1 " ELSE ." 0 " THEN ;
    \ byte ---
    : XS1   DUP 80 AND ZO1 ." D register"
            DUP 40 AND ZO1 ." Watchdog timeout"
            DUP 20 AND ZO1 ." Data out ready"
            DUP 10 AND ZO1 ." Software busy"
            DUP  8 AND ZO1 ." Poll Micro"
            DUP  4 AND ZO1 ." INT1"
            DUP  2 AND ZO1 ." INT0"
                 1 AND ZO1 ." Osc busy" ;

    [157]

    : .IS   [ CS 2+ ] LITERAL C@ ;
    : .IS   @IS CR ." Internal bus status" XSl ; -->
    191
    \                                                 16:46 02/02/89
    HEX
    FFC0    CONSTANT KREG
    9F      CONSTANT SM0            9E      CONSTANT SM1
    9D      CONSTANT SM2            B5      CONSTANT P3.5
    99      CONSTANT SBUF           D0      CONSTANT PSW.0
    99      CONSTANT TI     \ SCON.1
    D3      CONSTANT RS0            D4      CONSTANT RS1

    : RLOGO ." R Register"

    : RRULER0        ." 1    O" ;

    : RRULER1        ." 54321098765432xQ" ;

    : RRULER CR RLOGO CR RRULER0 CR RRULER1 ; -->
    192
    \                                                 10:01 12/13/88
    HEX
    \ byte ---
    : .8BITS        DUP 80 AND IF 31 EMIT ELSE 30 EMIT THEN
                    DUP 40 AND IF 31 EMIT ELSE 30 EMIT THEN
                    DUP 20 AND IF 31 EMIT ELSE 30 EMIT THEN
                    DUP 10 AND IF 31 EMIT ELSE 30 EMIT THEN
                    DUP 08 AND IF 31 EMIT ELSE 30 EMIT THEN
                    DUP 04 AND IF 31 EMIT ELSE 30 EMIT THEN
                    DUP 02 AND IF 31 EMIT ELSE 30 EMIT THEN
                    DUP 01 AND IF 31 EMIT ELSE 30 EMIT THEN
                    DROP ;
    -->

    193
    \                                                 08:47 06/30/89
    HEX
    \ --- byte
    : @R0           [ XBUS 2+ ] LITERAL C@ ; \ ?
    \ --- byte
    : @R1           [ XBUS 3 + ] LITERAL C@ ; \ ?
    -->

    194
    \                                                 15:30 02/04/89
    HEX
    : (.R)  BASE @ >R 2 BASE !
            [ KREG 0 + ] LITERAL C@ .8BITS
            [ KREG 1 + ] LITERAL C@ .8BITS
            R> BASE ! ;

    : .RREG RRULER CR (.R) ;
    : (.R10) BASE @ >R 2 BASE !
            @R1 .8BITS

    [158]

            @R0
            DUP 80 AND IF 31 EMIT ELSE 30 EMIT THEN
            40 AND IF 31 EMIT ELSE 30 EMIT THEN
            R> RASE !

    : .R10  RRULER CR (.R10) ; -->
    195
    \                                                 09:25 07/02/89
    HERE LABEL (CLRR) ASSEMBLER RESET BEGIN$
            DPTR # KREG 3 + MOV
            @DPTR A MOVX
            RET END$ FORTH
    \ select the hardware R register software clock
    HERE LABEL (REXT) ASSEMBLER RESET BEGIN$
            DPTR # KREG 4 + MOV
            @DPTR A MOVX
            RET END$ FORTH
    HERE LABEL (RINT) ASSEMBLER RESET BEGIN$
            DPTR # KREG 5 + MOV
            @DPTR A MOVX
            RET END$ FORTH -->

    l96
    \ load hardware r register                        09:25 07/02/89
    \ S0H high byte address, S0L low byte address
    HERE LABEL (TOR) ASSEMBLER RESET BEGIN$
            (REXT) LCALL
            C CLR A S0L MOV A RLC S0L A MOV
                  A S0H MOV A RLC S0H A MOV
            C CLR A S0L MOV A RLC S0L A MOV
                  A S0H MOV A RLC S0H A MOV
            SM0 CLR  SM1 CLR  SM2 CLR   \ enable mode 0 output
            P3.0 SETB  P3.1 SETB        \ enable mode 0 output
            RS0 SETB  RS1 SETB          \ select bank 3
            TI CLR  SBUF S0L MOV
    1 $:    TI 1 $ JNB  TI CLR  SBUF S0H MOV
    2 $:    TI 2 $ JNB  RS0 CLR  RS1 CLR \ select bank 0
            (RINT) LCALL
            RET END$ FORTH -->
    197
    \                                                 18:56 06/29/89
    HEX
    FFD0    CONSTANT VREG
    DECIMAL
    \ bit\address ---
    CODE !RAM       (S0) LCALL (S1) LCALL
                    R4 DPH MOV R5 DPL MOV
                    (TOR) LCALL
                    DPTR # VREG 6 + MOV @DPTR A MOVX
                    A # 100 MOV  10 $:  ACC.0 10 $ DJNZ
    \               P1.6 CLR \ -busy
                    DPTR # KREG 2 + MOV
                    A S1L MOV
                    @DPTR A MOVX
                    NEXT LJMP END-CODE -->

    [159]

    198
    \                                                 19:04 06/29/89
    DECIMAL
    \ address --- bit
    CODE @RAM       (S0) LCALL R4 DPH MOV R5 DPL MOV (TOR) LCALL
                    DPTR # VREG 5 + MOV @DPTR A MOVX
                    DPTR # VREG 4 + MOV @DPTR A MOVX
    \               P1.6 SETB \ busy
                    DPTR # KREG 1+ MOV
                    A @DPTR MOVX ACC.0 PUSH
                    DPTR # VREG 6 + MOV @DPTR A MOVX
                    A # 100 MOV 10 $: ACC.0 10 $ DJNZ
    \               P1.6 CLR \ -busy
    ACC.0 POP         A # 1 ANL
                    DPH R4 MOV DPL R5 MOV
                    A0PUSH LJMP
                    END-CODE -->
    199
    \                                                 15:04 06/29/89
    DECIMAL
    \ address ---
    CODE TOR  (S0) LCALL  R4 DPH MOV  R5 DPL MOV
              (TOR) LCALL  NEXT LJMP END-CODE

    CODE CLRR (CLRR) LCALL  NEXT LJMP  END-CODE
    CODE REXT (REXT) LCALL  NEXT LJMP  END-CODE
    CODE RINT (RINT) LCALL  NEXT LJMP  END-CODE
    -->

    200
    \                                                 16:45 02/03/89
    HEX
    4000    CONSTANT RAMSIZE
    \ bit --- flag
    : RT    RAMSIZE 0
            DO CR I U. 0 I !RAM I @RAM 1 AND
              IF ." bad zero" THEN
              1 I !RAM I @RAM 0=
              IF ." bad one" THEN
              ?TERMINAL IF CURSOR QUIT THEN
            LOOP DROP ;
    -->

    201
    \                                                 15:20 02/02/89
     HEX
    \ start address \length
    : DRAM  CR REXT -CURSOR
            OVER + SWAP DO I @RAM
            IF 31 EMIT ELSE 30 EMIT THEN LOOP
            CR CURSOR ;
     DECIMAL
    -->

    [160]

    202
    \                                                 18:09 07/08/89
    \ length ---
    CODE  (ZERORAM) (S0) LCALL  R4 DPH MOV  R5 DPL MOV
                     S1H S0H MOV S1L S0L MOV S1H INC
                     DPTR # VREG 6 + MOV @DPTR A MOVX \ -busy
                     A # 24 MOV 10 $: ACC.0 10 $ DJNZ
                     A CLR S2H A MOV S2L A MOV P3.5 CLR
               1 $:  S0H S2H MOV S0L S2L MOV (TOR) LCALL
                     S2L INC A S2L MOV 0=
                     IF S2H INC THEN
                     DPTR # KREG 2 + MOV
                     A CLR @DPTR A MOVX
                     S1L 1 $ DJNZ
                     S1H 1 $ DJNZ
                     NEXT LJMP END-CODE
    : ZERORAM        RAMSIZE (ZERORAM) ; -->
    203
    \ Compute R register feed back values             16:15 10/30/90
    HEX \ any feedback
    \ R2 bank 3 high byte R, R3 low byte R --- Carry = feedback bit
    HERE LABEL (RFB) ASSEMBLER RESET BEGIN$
            R0 # 0 MOV                  \ clear R0 bank 0
            RS0 SETB  RS1 SETB          \ select bank 3
            A R2 MOV    \ test high byte address
            PSW 3 $ JB  \ jump if high byte odd
            A R3 MOV    \ test low byte
            PSW 1 $ JNB \ is even
            2 $ SJMP    \ is odd
       3 $: A R3 MOV    \ test low byte address
            PSW 2 $ JNB \ is odd
    -->

    204
    \                                                 16:15 10/30/90
    HEX
    1 $:    C CLR           \ even number of bits
            4 $ SJMP
    2 $:    C SETB          \ odd number of bits
    4 $:    RS0 CLR RS1 CLR              \ select bank 0
            RET END$ FORTH -->

    205
    \                                                 15:06 06/29/89
    HEX
    CODE INITRAM    DPTR # VREG 6 + MOV  @DPTR A MOVX
    \               P1.6 CLR \ -busy
                    1C # RAMSIZE 100 / MOV
                    1D # RAMSIZE FF AND MOV
                    A 1D MOV  0<>
                    IF 1C INC THEN
              1 $:  S0H 1C MOV  S0L 1D MOV  (TOR) LCALL -->

    206
    \                                                 13:14 07/01/89

    [161]

                    1A 1C MOV  1B 1D MOV
                    C CLR A 1B MOV A RLC 1B A MOV
                    A 1A MOV  A RLC  1A A MOV
                    C CLR A 1B MOV A RLC 1B A MOV
                    A 1A MOV  A RLC  1A A MOV  (RFB) LCALL
                    A CLR CARRY
                    IF A INC THEN
                    DPTR # KREG 2 + MOV
                    @DPTR A MOVX
                    1D 1 $ DJNZ 1C 1 $ DJNZ
                    NEXT LJMP END-CODE
    -->

    207
    \                                                 12:49 02/04/89
    DECIMAL
    0 VARIABLE SRREG

    : INITR 0 SRREG ! ;

    : Z1   AND 0> ;

    : @R    SRREG @
    -->

    208
    \                                                 18:31 06/29/89
    HEX
    \ --- 0 or 1
    : A10     @R   40 Z1 ;
    : A9      @R   80 Z1 ;
    : A8      @R  100 Z1 ;
    : A7      @R  208 Z1 ;
    : A6      @R  400 Z1 ;
    : A5      @R  800 Z1 ;
    : A4      @R 1000 Z1 ;
    : A3      @R 2000 Z1 ;
    : A2      @R 4000 Z1 ;
    : A1      @R 8000 Z1 ;
    -->

    209
    \                                                 12:52 02/04/89

    : A11   A1 A5 AND
            A1 0= A9 0= AND XOR
            A6 A10 XOR XOR ;
    -->

    210
    \                                                 18:01 02/04/89
    DECIMAL
    : .SRREG BASE @ >R 2 BASE ! SRREG @ 0
            <# # # # # # # # # # # #> TYPE R> BASE !

    [162]

    HEX
    : TR    CR 4000 0
            DO I 100 MOD 0= IF ." ." THEN
               I 2* 2* SRREG ! A11
              I @RAM <>
                IF CR I U. ." <>" THEN
              ?TERMINAL IF LEAVE THEN
            LOOP ; -->

    211
    \                                                 13:25 05/12/89
    HEX

    : VLOGO         ." V Register" ;

    : VRULER0       ." 1    0" ;

      VRULER1       ." 5432109876543210" ;

    : VRULER CR VLOGO CR VRULER0 CR VRULER1 ; -->

    212
    \                                                 16:20 02/04/89
    HEX
    : (.V)  BASE @ >R 2 BASE !
            [ VREG 1+ ] LITERAL C@ .8BITS
            VREG C@ .8BITS
            R> BASE ! ;

    : .V    VRULER CR (.V) ;

    : (.VOCT) BASE @ >R 8 BASE !
             [ VREG 1+ ] LITERAL C@ 100 * VREG C@ OR 0
             <# # # # # # # #> TYPE R> BASE ! ;
    : .VOCT CR (.VOCT) ; -->

    213
    \                                                 13:51 07/01/89
    HERE LABEL (CLRV) ASSEMBLER RESET BEGIN$
            DPTR # VREG MOV
            @DPTR A MOVX
            RET  END$ FORTH
    \ select the hardware v register software clock
    HERE LABEL (VEXT) ASSEMBLER RESET BEGIN$
            DPTR # VREG 2+ MOV
            @DPTR A MOVX
            RET  END$ FORTH
    HERE LABEL (VINT) ASSEMBLER RESET BEGIN$
            DPTR # VREG 3 + MOV
            @DPTR A MOVX
            RET  END$ FORTH -->

    214
    \                                                 13:45 07/01/89
    HEX

    [163]

    CODE CLRV       (CLRV) LCALL  NEXT LJMP  END-CODE
    CODE VEXT  (VEXT) LCALL  NEXT LJMP  END-CODE
    CODE VINT  (VINT) LCALL  NEXT LJMP  END-CODE

    : GO    0 [ VREG 4 + ] LITERAL C! ;
    : CNT   [ VREG 7 + ] LITERAL ;
    : .CNT  BASE @ >R CR CNT C@ HEX U. R> BASE ! ;
    -->

    215
    \ load hardware v register                        14:36 06/30/89
    DECIMAL
    HERE LABEL (>V) ASSEMBLER RESET BEGIN$
            SM0 CLR  SM1 CLR  SM2 CLR   \ enable mode 0 output
            P3.0 SETB P3.1 SETB         \ enable mode 0 output
            RS0 SETB RS1 SETB           \ bank 3
            (VEXT) LCALL
            TI CLR SBUF R0 MOV
    1 $:    TI 1 $ JNB
            TI CLR  SBUF R1 MOV
    2 $:    TI 2 $ JNB
            RS0 CLR RS1 CLR             \ bank 0
            (VINT) LCALL
            RET  END$ FORTH -->

    216
    \                                                 14:43 06/30/89
    HEX
    18      CONSTANT V0
    19      CONSTANT V1
    \ word
    CODE >V (S0) LCALL  R4 DPH MOV  R5 DPL MOV
            V1 S0H MOV  V0 S0L MOV
            (>V) LCALL  NEXT LJMP  END-CODE

    CODE CLOCK      P3.1 CLR  P3.1 SETB  NEXT LJMP  END-CODE -->

    217
    \                                                 14:05 12/27/89
    HEX
    0FFE0    CONSTANT FREG

    : FLOGO ." F Register"
            CR ." x is the unused 64th bit of the linear feedback sh
    ift register" ;

    : RULER0        ." 6  5         4         3         2         1
            0"

    : RULER1        ." 210987654321098765432109876543210987654321098
    765432109876543210x" ;

    : RULER CR FLOGO CR RULER0 CR RULER1 ; -->

    218

    [164]

    \                                                 11:58 02/03/89
    DECIMAL
    : (.F)  BASE @ >R 2 BASE !
            [ FREG 7 + ] LITERAL C@ .8BITS
            [ FREG 6 + ] LITERAL C@ .8BITS
            [ FREG 5 + ] LITERAL C@ .8BITS
            [ FREG 4 + ] LITERAL C@ .8BITS
            [ FREG 3 + ] LITERAL C@ .8BITS
            [ FREG 2 + ] LITERAL C@ .8BITS
            [ FREG 1 + ] LITERAL C@ .8BITS
            [ FREG 0 + ] LITERAL C@ .8BITS
            R> BASE ! ;

    : .F    RULER CR (.F); -->

    219
    \                                                 15:17 02/04/89
    HEX
    : .OCT0 BASE @ >R 8 BASE ! 0
            <# # # # # # #>       TYPE R> BASE ! ;
    : .OCT1 BASE @ >R 8 BASE
            <# # # # # # # # # #> TYPE R> BASE
    -->

    220
    \                                                 16:38 02/04/89
    : (.FOCT) [ FREG 7 + ] LITERAL C@ 100 *
              [ FREG 6 + ] LITERAL C@ OR 0 2 U/ .OCT0 DROP
              [ FREG 4 + ] LITERAL C@ 100 *
              [ FREG 3 + ] LITERAL C@ OR 0 2 U/ SWAP DROP
              [ FREG 5 + ] LITERAL C@ 1 AND IF 8000 ELSE 0 THEN OR
              [ FREG 6 + ] LITERAL C@ 1 AND IF 80 ELSE 0 THEN
              [ FREG 5 + ] LITERAL C@ 2/ OR .OCT1
              [ FREG 1 + ] LITERAL C@ 100 *
              [ FREG     ] LITERAL C@ OR 0 2 U/ SWAP DROP
              [ FREG 2 + ] LITERAL C@ 1 AND IF 8000 ELSE 0 THEN OR
              [ FREG 3 + ] LITERAL C@ 1 AND IF 80 ELSE 0 THEN
              [ FREG 2 + ] LITERAL C@ 2/ OR .OCT1
    : .FOCT CR (.FOCT) ; -->

    221
    \                                                 09:29 07/02/89
    HERE LABEL (CLRF) ASSEMBLER RESET BEGIN$
            DPTR # FREG MOV @DPTR A MOVX RET END$ FORTH
    \ select the hardware f register software clock
    HERE LABEL (FEXT) ASSEMBLER RESET BEGIN$
            DPTR # FREG 1+ MOV @DPTR A MOVX RET END$ FORTH
    HERE LABEL ( FINT ) ASSEMBLER RESET BEGIN$
            DPTR # FREG 2+ MOV @DPTR A MOVX RET END$ FORTH

    CODE CLRF (CLRF) LCALL NEXT LJMP END-CODE
    CODE FEXT (FEXT) LCALL NEXT LJMP END-CODE
    CODE FINT (FINT) LCALL NEXT LJMP END-CODE -->

    222

    [165]

    \ load the hardware f register                    09:23 07/02/89
    DECIMAL
    HERE LABEL (>F) ASSEMBLER RESET BEGIN$
            ( FEXT ) LCALL
            SM0 CLR SM1 CLR SM2 CLR     \ enable mode 0 output
            P3.0 SETB P3.1 SETB         \ enable mode 0 output
            RS1 SETB                    \ select register bank 2
            TI CLR SBUF R7 MOV
    1 $:    TI 1 $ JNB
            TI CLR SBUF R6 MOV
    2 $:    TI 2 $ JNB
            TI CLR SBUF R5 MOV
    3 $:    TI 3 $ JNB
            TI CLR SBUF R4 MOV
    4 $:    TI 4 $ JNB
    -->

    223
    \ load  the hardware f register                   09:24 07/02/89

            TI CLR SBUF R3 MOV
    5 $:     TI 5 $ JNB
             TI CLR SBUF R2 MOV
    6 $:     TI 6 $ JNB
             TI CLR $ BUF R1 MOV
    7 $:     TI 7 $ JNB
             TI CLR SBUF R0 MOV
             RS1 CLR                    \ select register bank 0
    8 $:     TI 8 $ JNB
             ( FINT ) LCALL
             RET
    END$ FORTH -->

    224
    \                                                 12:00 06/30/89
    DECIMAL
    \ F1F0\F3F2\F5F4\F7F6 ---
    CODE >F GET_SP LCALL RS1 SETB \ register bank 2
            DPTR INC  A @DPTR MOVX  R0 A MOV
            DPTR INC  A @DPTR MOVX  R1 A MOV
            DPTR INC  A @DPTR MOVX  R2 A MOV
            DPTR INC  A @DPTR MOVX  R3 A MOV
            DPTR INC  A @DPTR MOVX  R4 A MOV
            DPTR INC  A @DPTR MOVX  R5 A MOV
            DPTR INC  A @DPTR MOVX  R6 A MOV
            DPTR INC  A @DPTR MOVX  R7 A MOV
            RS1 CLR \ register bank 0
            R4 DPH MOV  R5 DPL MOV
            (>F) LCALL
            NEXT LJMP END-CODE -->
    225
    \                                                 13:45 10/30/90
    DECIMAL
    : CLROSC [ VREG 4 + ] LITERAL C@ DROP;
    : SGO   0 [ VREG 4 + ] LITERAL C! ;
    : -OSC  0 [ VREG 5 + ] LITERAL C! ;

    [166]

    : OSC   0 [ VREG 6 + ] LITERAL C! ;
    : STEP  [ VREG 7 + ] LITERAL ;
    : .STEP BASE @ >R CR STEP C@ HEX U. R> BASE ! ;
    : >STEP 29 STEP C! ;  \ any step
    : INITOSC >STEP CLK -OSC ;
    CODE CLK        P3.1 SETB  NEXT LJMP  END-CODE
    CODE -CLK       P3.1 CLR  NEXT LJMP  END-CODE
    CODE ONE        P3.0 SETB  NEXT LJMP  END-CODE
    CODE ZERO       P3.0 CLR  NEXT LJMP   END-CODE
    : .DOV   [ BUSVIEW 1+ ] LITERAL C@   8 AND 0> SPACE . ;
    : .FOUT  [ BUSVIEW 2+ ] LITERAL C@  40 AND 0> SPACE . ; -->
    226
    \                                                 09:27 07/02/89
    HEX
    \ byte ---
    : TOD   DEXT 8 0 DO DUP 1 AND
            IF ONE ELSE ZERO THEN CLOCK
            2/ LOOP ;
    : .OSCLOGO  CR ." S83B" ;

    : (.OSC) [ BUSVIEW 1+ ] LITERAL C@
             DUP  4 AND IF 31 EMIT ELSE 30 EMIT THEN
             DUP  2 AND IF 31 EMIT ELSE 30 EMIT THEN
             DUP  1 AND IF 31 EMIT ELSE 30 EMIT THEN
             DUP 10 AND IF 31 EMIT ELSE 30 EMIT THEN
             DROP ;

    : .OSC  .OSCLOGO CR (.OSC) ; -->
    227
    \                                                 15:19 12/27/89
    HEX
    CODE >DA        DPTR # XBUS MOV
              1 $:  A @DPTR MOVX ACC.0 1 $ JB
                    A # OFF MOV @DPTR A MOVX
              2 $:  A @DPTR MOVX ACC.0 2 $ JB
                    A # OFF MOV @DPTR A MOVX
              3 $:  A @DPTR MOVX ACC.0 3 $ JB
                    A CLR @DPTR A MOVX
              4 $:  A @DPTR MOVX ACC.0 4 $ JB
                    A CLR  @DPTR A MOVX  NEXT LJMP  END-CODE
    -->
    : RT1FA    BEGIN 0 0 0 8000 >F FINT 0FF00 >V VINT CLRR RINT
                 INITOSC OSC DINT >DA
                 CR (.FOCT) SPACE (.VOCT) SPACE (.R10) ?TERMINAL
               UNTIL ; -->
    228
    \                                                 14:12 12/27/89
    HEX
    1A      CONSTANT KEYHI 1B       CONSTANT KEYLO

    1C      CONSTANT FRAME3 1D      CONSTANT FRAME2
    1E      CONSTANT FRAME1 1F      CONSTANT FRAME0

    : EFRAMES       0 FRAME0 PC! 0 FRAME1 PC!

    [167]

                    0 FRAME2 PC! 0 FRAME3 PC! ;
    HERE LABEL (ACKI0) ASSEMBLER RESET BEGIN$
            P1.0 CLR P1.0 SETB RET
    END$ FORTH
    CODE ACKI0 (ACKI0) LCALL  NEXT LJMP  END-CODE -->

    229
    \                                                 14:16 12/27/89
    HEX
    0A8     CONSTANT IE
    ASSEMBLER RESET BEGIN$
    HERE LABEL (-EX0)  IE CLR  RET
    HERE LABEL (+EX0)  IE SETB  RET
    HERE LABEL (+EXl)  IE 2+ SETB  RET
    HERE LABEL (-EX1)  IE 2+ CLR  RET
    HERE LABEL (+INT0)  P3.0 2+ SETB  RET
    END$ FORTH

    CODE +INT0      (+INT0) LCALL NEXT LJMP END-CODE
    CODE +EX0       (+EX0) LCALL  NEXT LJMP END-CODE
    CODE -EX0       (-EX0) LCALL  NEXT LJMP END-CODE
    CODE +EX1       (+EX1) LCALL  NEXT LJMP END-CODE
    CODE -EX1       (-EX1) LCALL  NEXT LJMP END-CODE -->
    230
    \                                                 11:30 12/27/89
    HEX
    0 CONSTANT FS
    HERE LABEL (FS) ASSEMBLER RESET BEGIN$
            PSW.0 PUSH  ACC.0 PUSH  DPH PUSH  DPL PUSH
            RS0 CLR  RS1 CLR
            A KEYHI MOV  A KEYLO ANL  A # 0A5 XRL  0=
            IF  (DEXT) LCALL  (-EX0) LCALL  1 $ SJMP
            THEN (>F) LCALL  (>V) LCALL  (CLRR) LCALL (ACKI0) LCALL
            A FRAME0 MOV  A # 1 ADD   FRAMEO A MOV
            A FRAME1 MOV  A # 0 ADDC  FRAMEl A MOV
            A FRAME2 MOV  A # 0 ADDC  FRAME2 A MOV
            A FRAME3 MOV  A # 0 ADDC  FRAME3 A MOV
      1 $:  DPL POP  DPH POP  ACC.0 POP  PSW.0 POP  RETI
    END$ FORTH -->

    231
    \                                                 03:14 11/30/89
    HEX
    : .FC   FRAME1 PC@ 100 * FRAME0 PC@ OR
            FRAME3 PC@ 100 * FRAME2 PC@ OR D. ;

    : .KEY# KEYHI PC@ 100 * KEYLO PC@ OR U. ;

    : .VI   CR V1 PC@ .8BITS  V0 PC@ .8BITS ;
    -->

    232
    \                                                 03:05 07/01/89
    HEX
    17      CONSTANT IF0            16 CONSTANT IF1

    [168]

    15      CONSTANT IF2            14 CONSTANT IF3
    13      CONSTANT IF4            12 CONSTANT IF5
    11      CONSTANT IF6            10 CONSTANT IF7

    : .FI   CR IF7 PC@ .8BITS  IF6 PC@ .8BITS
               IF5 PC@ .8BITS  IF4 PC@ .8BITS
               IF3 PC@ .8BITS  IF2 PC@ .8BITS
               IF1 PC@ .8BITS  IF0 PC@ .8BITS ; -->

    233
    \                                                 02:04 12/24/89
    HEX
    \ V ---
    : >IV   DUP V0 PC! 2/ 80 / V1 PC! ;

    \ F1F0\F3F2\F5F4\F7F6 ---
    : >IF   DUP IF6 PC! 2/ 80 / IF7 PC!
            DUP IF4 PC! 2/ 80 / IF5 PC!
            DUP IF2 PC! 2/ 80 / IF3 PC!
            DUP IF0 PC! 2/ 80 / IF1 PC!
    \ key # ---
    : >KEY# DUP KEYLO PC! >< KEYHI PC!

    \ --- key #
    : @KEY#  KEYHI PC@ >< KEYLO PC@ OR
    -->
    234
    \                                                 14:22 12/27/89
    HEX
    0B8     CONSTANT IP

    CODE +EA        IE 7 + SETB NEXT LJMP END-CODE
    CODE -EA        IE 7 + CLR  NEXT LJMP END-CODE
    CODE +PX0       IP SETB  NEXT LJMP  END-CODE
    CODE -PX0       IP CLR   NEXT LJMP  END-CODE
    : INT0ON        +INT0 -IT0 +EX0 +PX0 ;
    : INT0OFF       -EX0 ;
    -->
    : INT0ON        02 EXTI0 C! ' (FS) EXTI0 1+ ! P32 +EX0 +EA ;

    235
    \                                                 14:21 12/27/89
    HEX
    88      CONSTANT TCON

    CODE +IT0       TCON SETB NEXT LJMP END-CODE
    CODE -IT0       TCON CLR  NEXT LJMP END-CODE
    CODE +IT1       TCON 2+ SETB NEXT LJMP END-CODE
    CODE -IT1       TCON 2+ CLR  NEXT LJMP END-CODE
    CODE +IE1       TCON 3 + SETB NEXT LJMP END-CODE
    CODE -IE1       TCON 3 + CLR  NEXT LJMP END-CODE
    -->

    236
    \ Timer 0 mode 1                                  12:13 07/02/89

    [169]

    HEX
    8A CONSTANT TL0                 8C CONSTANT TH0

    TCON 4 + CONSTANT TR0           TCON 5 + CONSTANT TF0
    89 CONSTANT TMOD
    \ D3 CONSTANT RS0

    HERE LABEL (T0M1) ASSEMBLER RESET BEGIN$
            A TMOD MOV  A # 0F0 ANL  A # 1 ORL  TMOD A MOV
            RET END$ FORTH -->

    237
    \ timer 0 to 65536 microsconds @ 12 Mhz           19:53 07/08/89
    HEX
    \ low byte usec\high byte usec ---
    HERE LABEL (WAIT0) ASSEMBLER RESET BEGIN$
            (T0M1) LCALL R0 INC R0 INC
            A # FF MOV  C CLR  A @R0 SUBB  TL0 A MOV  \ FFFF - TIME
            A # FF MOV  R0 DEC  A @R0 SUBB  TH0 A MOV
            A TL0 MOV  A # 1 ADD  TL0 A MOV
            A TH0 MOV  A # 0 ADDC TH0 A MOV    \ FFFF - TIME + 1
            R0 INC  R0 INC
            TF0 CLR  TR0 SETB
      1 $:  TF0 1 $ JNB  TR0 CLR  RET  END$ FORTH
    \ low byte usec\high byte usec ---
    CODE WAIT0 ASP # ASP MOV  R0 ASP MOV  (S0) LCALL  R0 DEC
               @R0 S0L MOV  R0 DEC  @R0 S0H MOV  SAVE_SP LCALL
               (WAIT0) LCALL NEXT LJMP END-CODE -->
    238
    \                                                 04:16 11/30/89
    DECIMAL
    256     CONSTANT MQSIZE
    0       VARIABLE MQ -2 ALLOT-RAM MQSIZE ALLOT-RAM
    50      CONSTANT TO

    : ERASEMQ       MQ MQSIZE ERASE ;
    HEX
    HERE LABEL (0MQ) ASSEMBLER RESET BEGIN$
            DPTR # MQ MOV
            R1 # MQSIZE FF AND MOV  A CLR
      1 S:  @DPTR A MOVX  DPTR INC
            R1 1 $ DJNZ
            RET
            END$ FORTH
    CODE 0MQ (0MQ) LCALL  NEXT LJMP  END-CODE -->
    239
    \                                                 12:31 07/07/89
    HEX
    0F0     CONSTANT B.0
    HERE LABEL (IXl) ASSEMBLER RESET BEGIN$
            PSW.0 PUSH  ACC.0 PUSH  B.0 PUSH  DPH PUSH  DPL PUSH
            RS0 CLR  RS1 CLR \ bank 0
            DPTR # CS MOV  A @DPTR MOVX  ACC.0 PUSH   \ get byte
            DPTR # MQ MOV  A @DPTR MOVX  A INC  B.0 A MOV
            A DPL ADD  DPL A MOV  A CLR  A DPH ADDC  DPH A MOV

    [170]

            ACC.0 POP  @DPTR A MOVX
            DPTR # MQ MOV  A B.0 MOV  @DPTR A MOVX
            DPTR INC  A @DPTR MOVX  A B.0 SUBB  1 $ JNZ
            IE 2+ CLR \ int1 off
      1 $:  DPL POP  DPH POP  B.0 POP  ACC.0 POP  PSW.0 POP  RETI
            END$ FORTH -->

    240
    \ crc                                             12:14 07/02/89
    HEX
    10  CONSTANT CRCl  21  CONSTANT CRC0  \ SDLC, IBM CCITT

    \ byte in A reg
    \ X2 crc, X3L byte to crc, X3H bit counter
    HERE LABEL (CRCBYTE) ASSEMBLER RESET BEGIN$
                    S3L A MOV  \ get data byte
                    S3H # 8 MOV
              1 $:  C CLR
                    A S3L MOV  A RLC  S3L A MOV
                    A S2L MOV  A RLC  S2L A MOV
                    A S2H MOV  A RLC  S2H A MOV  CARRY
                    IF S2H # CRCl XRL S2L # CRC0 XRL THEN
                    S3H 1 $ DJNZ  RET  END$ FORTH -->
    \ HEX 80 CONSTANT CRC1 5 CONSTANT CRCO 0 \ crc-16 test
    241
    \ crc                                             12:14 07/02/89
    DECIMAL
    \ low address\high address\length ---
    \ crc is in X2
    HERE LABEL (CRC) ASSEMBLER RESET BEGIN$
            A CLR S2H A MOV S2L A MOV \ zero crc
            A @R0 MOV S0L A MOV
            R0 INC  DPH @R0 MOV  R0 INC  DPL @R0 MOV  R0 INC
      1 $:  A @DPTR MOVX  (CRCBYTE) LCALL  DPTR INC
            S0L 1 $ DJNZ
            RET  END$ FORTH -->

    242
    \                                                 13:45 07/02/89
    DFCIMAL
    CODE CRC ASP # ASP MOV  R0 ASP MOV  (S0) LCALL (S1) LCALL
            R4 DPH MOV  R5 DPL MOV
            R0 DEC @R0 S1L MOV
            R0 DEC @R0 S1H MOV
            R0 DEC @R0 S0L MOV
            (CRC) LCALL
            A CLR  (CRCBYTE) LCALL  A CLR  (CRCBYTE) LCALL
            GET_SP LCALL  A S2L MOV  @DPTR A MOVX
            A S2H MOV  APUSH LJMP  END-CODE -->

    243
    \                                                 12:15 07/02/89
    DECIMAL
    \ --- low crc\highcrc
    HERE LABEL (MQCRC) ASSEMBLER RESET BEGIN$

    [171]

            DPTR # MQ 1+ MOV  R0 DEC  @R0 DPL MOV
            R0 DEC  @RO DPH MOV  A @DPTR MOVX
            R0 DEC  @RO A MOV  (CRC) LCALL
            A CLR (CRCBYTE) LCALL  A CLR (CRCBYTE) LCALL
            R0 DEC @R0  S2L MOV  RO DEC @R0  S2H MOV
            RET  END$ FORTH -->

    244
    \                                                 12:15 07/02/89
    DECIMAL
    \ --- carry yes, no carry no
    HERE LABEL (?CRCOK) ASSEMBLER RESET BEGIN$
            DPTR # MQ 1+ MOV  A @DPTR MOVX
            R0 DEC  @R0 DPL MOV  R0 DEC  @R0 DPH MOV
            R0 DEC  @R0 A MOV  (CRC) LCALL
            A S2L MOV  A S2H ORL  C SETB  1 $ JZ  C CLR
      1 $:  RET  END$ FORTH -->

    245
    \                                                 13:03 01/23/90
    HEX
    \ --- 0 no message, 1 incomplete, 2 complete
    HERE LABEL (?MQ=) ASSEMBLER RESET BEGIN$
            R0 DEC  DPTR # MQ MOV  A @DPTR MOVX  1 $ JZ
            B.0 A MOV  DPTR INC  A @DPTR MOVX  C CLR  A B.0 SUBB
            2 $ JNZ  A # 2 MOV  1 $ SJMP
      2 $:  A # 1 MOV  @R0 A MOV RET
      1 $:  @R0 A MOV
            IE 2+ SETB \ int1 off
            RET  END$ FORTH -->

    246
    \                                                 10:41 07/09/89
    HEX
    0       CONSTANT MQRT
    \ --- 0 no message, 1 incomplete, 2 complete
    HERE LABEL (?MQ) ASSEMBLER RESET BEGIN$
            R1 # MQRT MOV
      1 $:  (?MQ=) LCALL  A @R0 MOV  R0 INC
            2 $ JNZ  3 $ SJMP  \ no message
      2 $:  C CLR  A # 2 SUBB 3 $ JZ
            R1 1 $ DJNZ
      3 $:  RO DEC  RET  END$ FORTH -->

    247
    \                                                 02:26 12/12/89
    \ --- 0 no message, 1 incomplete, 2 complete
    CODE ?MQ   ASP # ASP MOV  R0 ASP MOV  (?MQ) LCALL  GET_SP LCALL
               A @R0 MOV  R0 INC  A0PUSH LJMP  END-CODE
    \ --- low crc\highcrc
    CODE MQCRC ASP # ASP MOV  RO ASP MOV  (MQCRC) LCALL
               GET_SP LCALL  A @R0 MOV  ACC.0 PUSH
               R0 INC  A @R0 MOV
               @DPTR A MOVX  ACC.0 POP
               APUSH LJMP  END-CODE

    [172]

    \ --- carry yes, no carry no
    CODE CRCOK  ASP # ASP MOV  R0 ASP MOV  (MQCRC) LCALL
                (?CRCOK) LCALL  A CLR
                CARRY IF A # 1 MOV THEN
                GET_SP LCALL  A0PUSH LJMP  END-CODE -->

    248
    \                                                 13:08 07/02/89
    DECIMAL
    \ A reg contains byte to be written to data out
    HERE LABEL (IW) ASSEMBLER RESET BEGIN$
            DPTR # CS MOV
            @DPTR A MOVX
            RET  END$ FORTH -->

    249
    \                                                 07:52 11/30/89
    DECIMAL
    \ --- 0 no message, 1 message incomplete, 2 message
    HERE LABEL (?MESS) ASSEMBLER RESET BEGIN$
            (?MQ) LCALL  A @R0 MOV  RET  END$ FORTH -->

    250
    \                                                 10:59 07/09/89
    DECIMAL
    \ --- 0 no, 1 message incomplete, 2 message
    CODE ?MESS ASP # ASP MOV  R0 ASP MOV  (?MESS) LCALL
               GET_SP LCALL  A @R0 MOV  R0 INC
               A0PUSH LJMP  END-CODE
    -->

    251
    \                                                 09:05 07/03/89
    HEX
    0E5     CONSTANT ACC.5
    \ carry ok to send, no carry busy
    HERE LABEL (?SOK) ASSEMBLER RESET BEGIN$
            DPH PUSH  DPL PUSH
            DPTR # CS 2+ MOV  A @DPTR MOVX ACC.5  1 $ JNB
            (T0Ml) LCALL  TH0 # 0 MOV  TL0 # 0 MOV \ longest
            TF0 CLR  TR0 SETB
      3 $:  A @DPTR MOVX  ACC.5 1 $ JNB  TF0 3 $ JNB
            C CLR  2 $ SJMP
      1 $:  C SETB
      2 $:  TR0 CLR DPL POP  DPH POP  RET  END$ FORTH -->

            (T0M1) LCALL  TH0 # 0FC MOV  TL0 # 18 MOV \ 10 ms

    252
    \                                                 08:27 01/27/90
    DECIMAL -->
    \ address\length --- 0 message sent okay,  1 timeout,
    \ 2 zero length message, 4 message being received
    HERE LABEL (WMESS) ASSEMBLER RESET BEGIN$
            DPTR # MQ MOV  A @DPTR MOVX  3 $ JZ  A # 4 MOV  2 $ SJMP

    [173]

      3 $:  \ EA CLR \ disable lnterrupts
            A @R0 MOV  R1 A MOV
            R0 INC  DPH @R0 MOV  R0 INC  DPL @R0 MOV
            R0 INC  A R1 MOV  1 $ JNZ  A # 2 MOV  2 $ SJMP
      1 $:  (?SOK) LCALL  4 $ JNC
            A @DPTR MOVX  DPL PUSH  DPH PUSH  DPTR # CS MOV
            @DPTR A MOVX  DPH POP  DPL POP  DPTR INC  R1 1 $ WNZ
            A CLR 2 $ SJMP
      4 $:  A # 1 MOV
      2 $:  ( EA SETB )  @R0 A MOV  RET  END$ FORTH -->
    253
    \                                                 08:27 01/27/90
    DECIMAL     \ roseth's quad timeout
    \ address\length --- 0 message sent okay,  1 timeout,
    HERE LABEL (WMESS) ASSEMBLER RESET BEGIN$
            DPTR # MQ MOV  A @DPTR MOVX  3 $ JZ  A # 4 MOV  2 $ SJMP
      3 $:  \ EA CLR \ disable interrupts
            A @R0 MOV  R1 A MOV
            R0 INC  DPH @R0 MOV  R0 INC  DPL @R0 MOV
            R0 INC  A R1 MOV  1 $ JNZ  A # 2 MOV  2 $ SJMP
      1 $:  (?SOK) LCALL  5 $ JC  (?SOK) LCALL
    5 $ JC  (?SOK) LCALL  5 $ JC  (?SOK) LCALL  5 $ JC  4 $ JNC
      5 $:  A @DPTR MOVX  DPL PUSH  DPH PUSH  DPTR # CS MOV
            @DPTR A MOVX  DPH POP  DPL POP  DPTR INC  R1 1 $ DJNZ
            A CLR 2 $ SJMP
      4 $:  A # 1 MOV
      2 $:  ( EA SETB )  @R0 A MOV  RET  END$ FORTH -->
    254
    \                                                 14:19 07/02/89

    \ address\length --- 0 message sent okay,  1 timeout
    CODE WMESS ASP # ASP MOV  R0 ASP MOV  (S0) LCALL  (S1) LCALL
               R4 DPH MOV  R5 DPL MOV
               R0 DEC  @R0 S1L MOV  R0 DEC  @R0 S1H MOV
               R0 DEC  @R0 S0L MOV  (WMESS) LCALL
               GET_SP LCALL  A @R0 MOV  A0PUSH LJMP  END-CODE -->

    255
    \                                                 14:51 12/27/89
    HEX
    CODE P33   P3 3 + SETB  NEXT LJMP END-CODE

    : INT1ON        P33 -IT1 +EX1 ;
    : INT1OFF       P33 -EX1 ;
    -->

    256
    \                                                 15:52 12/27/89
    DECIMAL
    440    CONSTANT ABEEP           1000   CONSTANT 1SEC
    HEX

    : INITKEY#      0A5A5 >KEY# ;

    : INITAU        DEXT

    [174]

                    80 !LED ABEEP 1SEC 10 / BEEP
                    40 !LED -DOG -DOSC CLRDOG
                    20 !LED -OSC -SB -SPOLL @ID DROP
                    10 !LED INITOSC CLROSC INITRAM
                     8 !LED ABEEP 2* 1SEC 10 / BEEP
                    INITEE INITKEY# EFRAMES ; -->
    : @KEY          0FF00 >IV 0 0 0 8000 >IF 1 >KEY# EFRAMES
                    CLRF CLRV CLRR ;
    257
    \                                                 15:39 12/27/89
    HEX
    : +AUINTS       ACKI0 INT1ON +EA
                    0 !LED ABEEP 3 * 1SEC 10 / BEEP ;

    : -AUINTS       -EA INT0OFF INT1OFF
                    4 !LED ABEEP 2/ 1SEC 10 / BEEP ;

    : ARMREGS       INITOSC OSC FINT VINT RINT ;

    : GOAU          INITAU ARMREGS +AUINTS DINT ;
    : STOPAU        -AUINTS ;
    -->

    258
    \                                                 09:29 12/28/89
    HEX
    \ key # ---
    : TK    0MQ DUP >< MQ 3 + C! MQ 4 + C!
            0C 0 DO I DUP [ MQ 5 + ] LITERAL + C! LOOP
            >EEKEY
    -->

    259
    \                                                 21:51 11/30/89
    DECIMAL
    \ --- 0 = no message, 2 = message
    : ?M    ?MESS DUP 1 =
            IF 5 0
              DO ?MESS 2 =
                IF DROP 0 LEAVE THEN
              LOOP
              IF INT1OFF 0MQ INT1ON 0 ELSE 2 THEN
            THEN ; -->

    260
    \                                                 08:58 11/21/89

    : .MQ   BASE @ >R HEX MQ 1+ DUP C@ DUP 0>
            IF OVER + SWAP DO I C@ 0 <# # # #> TYPE LOOP
            ELSE DROP DROP
            THEN R> BASE ! ;

    : DHL>  @ID DROP 0MQ +AUINTS INT1ON
            BEGIN ?M 2 =

    [175]

              IF ( CR .MQ ) 0MQ INT1ON
              THEN ?TERMINAL
            UNTIL INT1OFF :
    -->

    261
    \                                                 03:08 12/12/89

    5       CONSTANT STATESIZE
    O       VARIABLE STATETABLE -2 ALLOT STATESIZE ALLOT

    : BLANKSTATE    STATETABLE STATESIZE BLANKS ;

    : TIMEOUT       " T" COUNT STATETABLE SWAP CMOVE
                   ( CR ." Timeoout!" ) ;
    : NOTIMEOUT     "  " COUNT STATETABLE SWAP CMOVE
    : ZEROLMESS     " 0" COUNT STATETABLE SWAP CMOVE
    : MESSIP        " I" COUNT STATETABLE SWAP CMOVE
    -->

    262
    \                                                 09:26 12/28/89
    DECIMAL
    : .DHLSTAT      ONGOSUB NOTIMEOUT TIMEOUT ZEROLMESS MESSIP
                    ENDGOSUB ;
    \ status ---
    : RESPONSE      OWBUFPTR 5 >WBUF 0 >WBUF >WBUF >DHL
                    ( .DHLSTAT ) DROP ;

    \ --- 1=okay message, O=crc fail
    : READMESS      SB CRCOK
                    IF   1 ( 0 RESPONSE ) ( CR ." Okay  " )
                    ELSE 0 1 RESPONSE ( CR ." CRC fail  " )
                    THEN ( .MQ ) ;
    -->

    263
    \                                                 03:09 12/12/89
    DECIMAL
    5       CONSTANT MAXONES

    : ?LONGM        @IS 4 AND IF 3 RESPONSE ( CR ." Long length " )
                    0MQ @ID DROP INT1ON DROP 0 THEN ;

    \  1 --- 0 no message, 2 message
    : WAITFOR2 MAXONES 0
              DO ?MESS 2 = IF DROP 0 LEAVE THEN LOOP
              IF 2 RESPONSE ( CR ." Short length " .MQ )
                0MQ @ID DROP INT1ON 0
              ELSE 2
              THEN ;
    -->

    264
    \                                                 22:04 11/21/89

    [176]

    \ --- 0 no, 2 message
    : ?MESSNOW ?MESS DUP 1 =
               IF WAITFOR2 THEN DUP
               IF ?LONGM THEN DUP
               IF 0 MO C! THEN : -->

    265
    \                                                 03:34 12/16/89
    DECIMAL
    \ --- status byte
    : INVALID       8 SENDSTATUS ;
    \ --- status byte
    : SENDFRAMECT   0WBUFPTR 8 >WBUF 1 >WBUF
                    FRAME3 PC@ >WBUF FRAME2 PC@ >WBUF
                    FRAME1 PC@ >WBUF FRAMEO PC@ >WBUF >DHL ;

    \  start address\end address---
    : AUID  " ABCDEFHI" COUNT OVER + SWAP ;
    \ --- status byte
    : SENDAUID      0WBUFPTR 12 >WBUF 4 >WBUF AUID
                    DO I C@ >WBUF LOOP >DHL ;
    -->

    266
    \                                                 21:53 12/25/89
    DECIMAL
    : SENDEETRACK   0WBUFPTR 68 >WBUF 5 >WBUF INITEE
                    64 0 DO I 32704 + EEC@ >WBUF LOOP >DHL ;
    : SENDPCHKSUM   0 SENDSTATUS ;
    HEX
    : SENDIKEY      0WBUFPTR 7 >WBUF 7 >WBUF @KEY# DUP
                    0A5A5 =
                    IF DROP 1
                    ELSE 0< IF 2 ELSE 0 THEN
                    THEN >WBUF
                    KEYHI PC@ >WBUF KEYLO PC@ >WBUF >DHL ;
    -->

    267
    \                                                 04:22 12/24/89
    DECIMAL
    \ status ---
    : INSTAT        0WBUFPTR 5 >WBUF 8 >WBUF >WBUF >DHL :

    \ key # ---  key status
    : @IKEY         (EEKEY>) WBUF 4 + C@ ;

    : INSTALLEEKEY  WBUF 2+ C@ >< WBUF 3 + C@ OR >KEY#
                    WBUF 5 + C@ >< WBUF 6 + C@ OR >IV
                    WBUF 13 + C@ >< WBUF 14 + C@ OR
                    WBUF 11 + C@ >< WBUF 12 + C@ OR
                    WBUF  9 + C@ >< WBUF 10 + C@ OR
                    WBUF  7 + C@ >< WBUF  8 + C@ OR >IF
                    EFRAMES CLRF CLRV CLRR :

    [177]

    -->

    268
    \                                                 15:22 12/27/89
    HEX
    \ --- MQ key number
    : MQKEY#        3MQPTR MQ> >< MQ> OR ;

    \ status ---
    : ?DON  IF DEXT INT1OFF ELSE DINT INT0ON THEN ;

    \ MQ key number --- status
    : EEKEY         @IKEY 1 AND 0=
                    IF INSTALLEEKEY 0
                    ELSE 0 >IV 0 0 0 0 >IF INITKEY# 1
                    THEN DUP ?DON INSTAT ;
    -->

    269
    \                                                 16:58 01/26/90
    HEX
    \ error number ---
    : KEYERROR      INSTAT DROP
                    R> DROP R> DROP R> DROP [COMPILE] ;S ;
    \ key# --- 0 no, error number
    : KEY#TOOBIG    #KEYS > IF 10 ELSE 0 THEN ;
    \ key# --- 0 no, error number
    : KEY#TOOSMALL  #UKEYS MINUS <  IF 20 ELSE 0 THEN ;
    \ key# --- 0 no, error number
    : KEY#THERE     @KEY# =  IF 8 ELSE 0 THEN ;
    -->

    270
    \                                                 16:35 01/26/90
    HEX
    \ 0 okay, error number ---
    : ?KEYERROR    -DUP IF SWAP DROP KEYERROR THEN ;

    : INSTALLKEY    MQKEY#
                    DUP KEY#TOOBIG   ?KEYERROR
                    DUP KEY#TOOSMALL ?KEYERROR
                    DUP KEY#THERE    ?KEYERROR
                    EEKEY ;

    : BULKERASE ECHIP 0WBUFPTR 5 >WBUF 9 >WBUF 0 >WBUF >DHL ;
    -->

    271
    \                                                 08:08 12/16/89
    DECIMAL
    : EWBUF         ERASEWBUF 0 SENDSTATUS ;
    : SENDKEYDATA   3MQPTR MQ> >< MQ> OR EEKEY> ;
    : SENDUNSOL     >DHL ;

    \ status ---
    : KEYDATSTAT    0WBUFPTR $ >WBUF 13 >WBUF >WBUF >DHL ;

    [178]

    -->

    268
    \                                                 15:22 12/27/89
    HEX
    \ --- MQ key number
    : MQKEY#        3MQPTR MQ> >< MQ> OR ;

    \ status ---
    : ?DON  IF DEXT INT1OFF ELSE DINT INT0ON THEN ;

    \ MQ key number --- status
    : EEKEY         @IKEY 1 AND o=
                    IF INSTALLEEKEY 0
                    ELSE 0 >IV 0 0 0 0 >IF INITKEY# 1
                    THEN DUP ?DON INSTAT ;
    -->

    269
    \                                                 16:58 01/26/90
    HEX
    \ error number ---
    : KEYERROR      INSTAT DROP
                    R> DROP R> DROP R> DROP [COMPILE] ;S ;
    \ key# --- 0 no, error number
    : KEY#TOOBIG    #KEYS > IF 10 ELSE 0 THEN ;
    \ key# --- 0 no, error number
    : KEY#TOOSMALL  #UKEYS MINUS <  IF 20 ELSE 0 THEN ;
    \ key# --- 0 no, error number
    : KEY#THERE     @KEY# =  IF 8 ELSE 0 THEN ;
    -->

    270
    \                                                 16:35 01/26/90
    HEX
    \ 0 okay, error number ---
    : ?KEYERRoR    -DUP IF SWAP DROP KEYERROR THEN ;

    : INSTALLKEY    MQKEY#
                    DUP KEY#TOOBIG   ?KEYERROR
                    DUP KEY#TOOSMALL ?KEYERROR
                    DUP KEY#THERE    ?KEYERROR
                    EEKEY ;

    : BULKERASE     ECHIP 0WBUFPTR 5 >WBUF 9 >WBUF 0 >WBUF >DHL ;
    -->

    271
    \                                                 08:08 12/16/89
    DECIMAL
    : EWBUF         ERASEWBUF 0 SENDSTATUS ;
    : SENDKEYDATA   3MQPTR MQ> >< MQ> OR EEKEY> ;
    : SENDUNSOL     >DHL ;

    \ status ---
    : KEYDATSTAT    0WBUFPTR 5 >WBUF 13 >WBUF >WBUF >DHL ;

    [179]

    : LOADKEYDAT    >EEKEY 0 KEYDATSTAT ;
    -->

    272
    \                                                 17:05 01/26/90
    : DOMESS MQ 2+ C@
          ONGOSUB
            INVALID SENDFRAMECT SETTIME SENDTIME SENDAUID
            SENDEETRACK SENDPCHKSUM SENDIKEY INSTALLKEY BULKERASE
            ERASEWBUF SENDKEYDATA SENDUNSOL LOADKEYDAT
            INVALID
          ENDGOSUB ( .DHLSTAT ) DROP ;
    -->

    273
    \                                                 08:32 01/27/90

    : LOOKFORMESS ?MESSNOW
                  IF SB READMESS
                    IF DOMESS 0MQ INT1ON THEN
                  THEN ;

    : INFLOOP     BEGIN LOOKFORMESS -SB AGAIN ;

    : RUNAU GOAU INFLOOP ;
    -->

[180 blank]